home *** CD-ROM | disk | FTP | other *** search
/ CU Amiga Super CD-ROM 11 / CU Amiga Magazine's Super CD-ROM 11 (1997)(EMAP Images)(GB)(Track 1 of 3)[!][issue 1997-06].iso / cucd / programming / oberonv4 / source / system / amiga.mod (.txt) next >
Oberon Text  |  1997-01-28  |  27KB  |  738 lines
  1. Syntax20b.Scn.Fnt
  2. ParcElems
  3. Alloc
  4. Syntax24b.Scn.Fnt
  5. Syntax10.Scn.Fnt
  6. Syntax10b.Scn.Fnt
  7. Syntax10i.Scn.Fnt
  8. Syntax16.Scn.Fnt
  9. (* AMIGA *)
  10. MODULE Amiga;
  11.     Data types, constants, variables, and procedures used to interface
  12.     to the Amiga OS, and to link various high-level modules together.
  13. IMPORT
  14.     SYSTEM,  A:=AmigaAsl, D:=AmigaDos, E:=AmigaExec, G:=AmigaGraphics,
  15.     I:=AmigaIntuition, U:=AmigaUtility, T:=AmigaTimer;
  16. CONST
  17.         These default values are used, if no Oberon4Amiga environment
  18.         variable was found.
  19.     defaultHeight =800;
  20.     defaultWidth = 1024;
  21.     defaultDepth = 4;
  22.     maxDepth = 8;
  23.         The name of the environment variable used. envarcName is
  24.         used for pre V39 AmigaOS, where the copy in the ENVARC:
  25.         directory is not made automatically by SetEnv.
  26.     envName = "Oberon4Amiga";
  27.     envarcName = "ENVARC:Oberon4Amiga";
  28.         The first value of the environment variable contains a version
  29.         field. This is the current version.
  30.     infoVersion = 6;
  31.     pointerSize = 8;
  32.         The title of the screen, and also the copyright notice appearing
  33.         in the Log on system startup.
  34.     screenTitle = "Oberon System V4 for Amiga V1.4";
  35.     TrapErr* = 0; ExceptionErr* = 1; SystemErr* = 2;    (** values for ErrorFrame.type *)
  36.         The sizes for the ChipMemPool
  37.      PoolPuddleSize = 32768; PoolThreshSize = PoolPuddleSize DIV 2;
  38.     Absolute=LONGINT;
  39.     Module=LONGINT;
  40.     NewProc*=PROCEDURE(tag:LONGINT):LONGINT;
  41.         The content of the environment varibale. Currently it is
  42.         stored binary, as is. All but the version field contain values
  43.         needed for opening the initial screen.
  44.     Info=RECORD
  45.         version:LONGINT;
  46.         displayID:LONGINT;
  47.         height:INTEGER;
  48.         width:INTEGER;
  49.         depth:INTEGER;
  50.         oscan:LONGINT;
  51.         autoScroll:BOOLEAN;
  52.         useWBWindow: BOOLEAN;
  53.         modifyColors: BOOLEAN
  54.     END;
  55.         Real pointers declarations. The Amiga* modules only
  56.         export these pointer types as LONGINT, to avoid
  57.         problems with the garbage collection.
  58.     ProcessPtr=POINTER TO D.Process;
  59.     ScreenPtr=POINTER TO I.Screen;
  60.     WindowPtr=POINTER TO I.Window;
  61.     BitmapPtr=POINTER TO G.BitMap;
  62.     RPPtr=POINTER TO G.RastPort;
  63.     IOExtTimerPtr = POINTER TO T.TimeRequest;
  64.         This is the Amiga specific way to store an Oberon
  65.         pattern.
  66.     PatternInfoPtr*= POINTER TO PatternInfo;
  67.     PatternInfo*= RECORD
  68.         modulo*: INTEGER;
  69.         w*, h*: SHORTINT;
  70.         data*: LONGINT; (* Pointer to individual pattern in chip mem. This pointer is used for patterns and Oberon fonts. *)
  71.         offset*: INTEGER; (* Offset to individual pattern in chip mem. This offset is used for Amiga fonts. *)
  72.     END;
  73.         characters are patterns with additional informations needed by the
  74.         Display.GetChar routine. They are not part of Patterns, because they are
  75.         of now use as soon, as the character was "transformed" into a
  76.         simple pattern by Display.GetChar.
  77.     CharInfo*=RECORD (PatternInfo) (* Font related character info *)
  78.         dx*, x*, y*: SHORTINT
  79.     END;
  80.         This is the Amiga specific representation of a font. Data and size point
  81.         to a contiguos memory block which contains all character data (as they
  82.         are build by the diskfont.library).
  83.     Font*= POINTER TO FontInfo;
  84.     FontInfo*= RECORD
  85.         data*: LONGINT; (* Pointer to character data block in chip mem. *)
  86.         size*: LONGINT; (* size of data block *)
  87.         info*: ARRAY 256 OF CharInfo;
  88.         amigaFont*: G.TextFontPtr;
  89.     END;
  90.         This contains the information needed as starting point to
  91.         build a trap viewer.
  92.     ErrorFrame*= RECORD
  93.         PC-: LONGINT;    (** PC value *)
  94.         SP-: LONGINT;    (** Stack Pointer *)
  95.         FP-: LONGINT;    (** Frame Pointer *)
  96.         type-: LONGINT;    (** type of error: TrapErr, ExceptionErr, SystemErr, 3 = Assertion, 4 = BreakPoint, 5 = Explicit *)
  97.         val-: LONGINT    (** type = TrapErr => trap number; type = ExceptionErr => exception mask (SET) *)
  98.     END;
  99.         Through this procedure variables, the routines from OLoad are called.
  100.         For this to work, OLoad will patch in the address of a procedure into
  101.         this variable. This can obviously work only, if the offset in memory
  102.         of this variable is known.
  103.         Therefore it is VERY IMPORTANT, that these variables remains the first
  104.         declared variables in the module, and thus start at offset -4.
  105.         The two guard variables are filled with some predefined values by OLoad
  106.         so that on module initialisation it can be verifyed, if the variables have
  107.         moved in respect to what OLoad expects .
  108.     guard1:LONGINT;
  109.     loaderCall:PROCEDURE();
  110.     guard2:LONGINT;
  111.         These variables export the window and rast port which have to be used
  112.         for the Oberon screen, as well as their dimensions.
  113.     Depth-, OberonDepth-, ColorOffset-: INTEGER;
  114.     Height-:INTEGER;
  115.     Width-:INTEGER;
  116.     window-: I.WindowPtr;
  117.     WBWindow-: BOOLEAN;
  118.     ModifyColors-: BOOLEAN;
  119.     PensObtained: BOOLEAN;
  120.         useLAltAsMouse enables the usage of the left alt key as a replacement
  121.         for a middle mouse button, when only a two button mouse is available.
  122.         This variable is initialised to TRUE.
  123.     useLAltAsMouse*:BOOLEAN;
  124.         This varible is initialised to the screen title. A read only variable is
  125.         exported instead of the screenTitle constant, to avoid the generation
  126.         of a new symbol file just because the string content has changed.
  127.     version-:ARRAY 64 OF CHAR;
  128.     idlePri*:SHORTINT;
  129.     normalPri*:SHORTINT;
  130.     thisTask- : E.TaskPtr;
  131.         This is the stack pointer to which the trap handler has to
  132.         return. It is remembered in Amiga.Loop and used in ???.
  133.     stackPtr-: LONGINT;
  134.         things for the Timer Device
  135.     TicsToWait*: LONGINT;        (*<<OJ*)
  136.         Name of the current printer. Will be send to the OberonPrint script
  137.     PrinterName*: ARRAY 64 OF CHAR;
  138.         Threshold for the Color of Pictures to be printed as white, 0<=n<=256
  139.     PictPrintThresh*: INTEGER;
  140.         Pointer to Chip-Memory-Pool (used only if exeVersion>=39
  141.     ChipMemPool-: E.MemPoolPtr;
  142.         Flag for the Requester of System.Quit
  143.     UseQuitRequester*: BOOLEAN;
  144.         Arrays for Character Conversion Amiga <-> Oberon
  145.     AtoO, OtoA: ARRAY 256 OF CHAR;
  146.         Swaps the bits within a byte
  147.     SwapBits- : ARRAY 256 OF SYSTEM.BYTE;
  148.         misc Amiga gfx objects
  149.     oldProcessWindow:I.WindowPtr;
  150.     screen:I.ScreenPtr;
  151.     pointerData: LONGINT;        (*<<OJ*)
  152.     Procedures of OLoad are called with register D3 containing the
  153.     address of a variable of type CallData. The first long word of CallData
  154.     contains a function code. The following  long words contain
  155.     parameters as requested by the specific function. Addresses are
  156.     passed whenever a VAR parameter is requested.
  157.     CallData=ARRAY 8 OF LONGINT;
  158. PROCEDURE -SaveRegs 048H,0E7H,0FFH,0FEH,02AH,04EH;
  159. (* MOVEM D0-D7/A0-A6,-(A7) MOVEA.L A6,A5 *)
  160. PROCEDURE -LoadRegs 04CH,0DFH,07FH,0FFH;
  161. (* MOVEM.L (A7)+,D0-D7/A0-A6 *)
  162. PROCEDURE CallModula(VAR data:CallData);
  163. BEGIN
  164.     SaveRegs;
  165.     SYSTEM.PUTREG(3,SYSTEM.ADR(data));
  166.     loaderCall(); (* The code for this is in OLoad. *)
  167.     LoadRegs
  168. END CallModula;
  169. PROCEDURE Allocate*(VAR adr:LONGINT; size:LONGINT);
  170.     Allocates an Amiga OS memory block. Used by Kernel and Fonts.
  171.     cd:CallData;
  172. BEGIN
  173.     cd[0]:=7;
  174.     cd[1]:=SYSTEM.ADR(adr);
  175.     cd[2]:=size;
  176.     CallModula(cd)
  177. END Allocate;
  178. PROCEDURE Assert*(cond:BOOLEAN; msg:ARRAY OF CHAR);
  179.     Perform an Arts.Assert.
  180.     cd:CallData;
  181. BEGIN
  182.     cd[0]:=10;
  183.     IF cond THEN cd[1]:=1 ELSE cd[1]:=0 END;
  184.     cd[2]:=SYSTEM.ADR(msg);
  185.     CallModula(cd)
  186. END Assert;
  187. PROCEDURE Deallocate*(adr:LONGINT; size:LONGINT);
  188.     Deallocates an Amiga OS memory block. Used by Kernel and Fonts.
  189.     cd:CallData;
  190. BEGIN
  191.     cd[0]:=12;
  192.     cd[1]:=adr;
  193.     cd[2]:=size;
  194.     CallModula(cd)
  195. END Deallocate;
  196. PROCEDURE GetSearchPath*(VAR searchPath: ARRAY OF CHAR);
  197.     Returns the search path which the loader received as
  198.     parameter.
  199.     cd:CallData;
  200. BEGIN
  201.     cd[0]:=17;
  202.     cd[1]:=SYSTEM.ADR(searchPath);
  203.     cd[2]:=LEN(searchPath);
  204.     CallModula(cd)
  205. END GetSearchPath;
  206. PROCEDURE ThisMod*(name:ARRAY OF CHAR; VAR module:Module; VAR res:INTEGER; VAR modules:Module; VAR imported:ARRAY OF CHAR);
  207.     With this routine, Modules.ThisMod accesses the loaders ThisMod
  208.     instead of reimplementing it.
  209.     cd:CallData;
  210. BEGIN
  211.     cd[0]:=4;
  212.     cd[1]:=SYSTEM.ADR(name);
  213.     cd[2]:=SYSTEM.ADR(module);
  214.     cd[3]:=SYSTEM.ADR(res);
  215.     cd[4]:=SYSTEM.ADR(modules);
  216.     cd[5]:=SYSTEM.ADR(imported);
  217.     CallModula(cd)
  218. END ThisMod;
  219. PROCEDURE ThisCommand*(mod:Module; cmdname:ARRAY OF CHAR; VAR adr:Absolute; VAR res:INTEGER);
  220.     With this routine, Modules.ThisCommand accesses the loaders ThisCommand
  221.     instead of reimplementing it.
  222.     cd:CallData;
  223. BEGIN
  224.     cd[0]:=5;
  225.     cd[1]:=mod;
  226.     cd[2]:=SYSTEM.ADR(cmdname);
  227.     cd[3]:=SYSTEM.ADR(adr);
  228.     cd[4]:=SYSTEM.ADR(res);
  229.     CallModula(cd)
  230. END ThisCommand;
  231. PROCEDURE Free*(name:ARRAY OF CHAR; all:BOOLEAN; VAR res:INTEGER; VAR modules:Module);
  232.     With this routine, Modules.Free accesses the loaders Free
  233.     instead of reimplementing it.
  234.     cd:CallData;
  235. BEGIN
  236.     cd[0]:=6;
  237.     cd[1]:=SYSTEM.ADR(name);
  238.     IF all THEN cd[2]:=1 ELSE cd[2]:=0 END;
  239.     cd[3]:=SYSTEM.ADR(res);
  240.     cd[4]:=SYSTEM.ADR(modules);
  241.     CallModula(cd)
  242. END Free;
  243. PROCEDURE Terminate*();
  244.     Calls Arts.Terminate to bringdown Oberon. Show Requester bevor quitting, if Amiga.UseQuitRequester is TRUE.
  245.     cd:CallData;
  246. BEGIN
  247.     I.ClearPointer(window);
  248.     IF (~UseQuitRequester) OR
  249.     (I.CallEasyRequest(window, {}, "Oberon System V4 for Amiga", "Do you really want to quit ?","Yes|No")#0) THEN
  250.         cd[0]:=3;
  251.         CallModula(cd)
  252.     END;
  253.     I.SetPointer(window,pointerData,0,0,0,0)
  254. END Terminate;
  255. PROCEDURE InstallNew*(proc:NewProc);
  256.     Passes the address of Kernel.SysNew to OLoad, so that
  257.     it can use it to fixx all NEW references.
  258.     cd:CallData;
  259. BEGIN
  260.     cd[0]:=0;
  261.     cd[1]:=SYSTEM.VAL(LONGINT,proc);
  262.     CallModula(cd)
  263. END InstallNew;
  264. PROCEDURE InstallSysNew*(proc:NewProc);
  265.     Passes the address of Kernel.SysNew to OLoad, so that
  266.     it can use it to fixx all SYSTEM.NEW references.
  267.     cd:CallData;
  268. BEGIN
  269.     cd[0]:=1;
  270.     cd[1]:=SYSTEM.VAL(LONGINT,proc);
  271.     CallModula(cd)
  272. END InstallSysNew;
  273. PROCEDURE InstallModuleList*(modList:LONGINT);
  274.     Passes the address of Kernel.module to OLoad, so that
  275.     it can update it, whenever it is needed (ThisMod/Free).
  276.     cd:CallData;
  277. BEGIN
  278.     cd[0]:=13;
  279.     cd[1]:=modList;
  280.     CallModula(cd)
  281. END InstallModuleList;
  282. PROCEDURE TermProcedure*(proc:PROCEDURE);
  283.     Passes the address of Kernel.FinalizeAll to OLoad, so that
  284.     it can call it on termination.
  285.     cd:CallData;
  286. BEGIN
  287.     cd[0]:=8;
  288.     cd[1]:=SYSTEM.VAL(LONGINT,proc);
  289.     CallModula(cd)
  290. END TermProcedure;
  291. PROCEDURE InstallTrapHandler*(p: PROCEDURE);
  292.     Installs trap handler in Arts.TrapStub
  293.     cd:CallData;
  294. BEGIN
  295.     cd[0]:=14;
  296.     cd[1]:=SYSTEM.VAL(LONGINT,p);
  297.     CallModula(cd)
  298. END InstallTrapHandler;
  299. PROCEDURE RestoreTrapHandler*;
  300.     restores old trap handler in Arts.TrapStub
  301.     cd:CallData;
  302. BEGIN
  303.     cd[0]:=15;
  304.     CallModula(cd)
  305. END RestoreTrapHandler;
  306. PROCEDURE GetErrorFrame*(VAR err: ErrorFrame);
  307.     gets trap information from Arts.errorFrame
  308.     cd:CallData;
  309. BEGIN
  310.     cd[0]:=16;
  311.     cd[1]:=SYSTEM.ADR(err);
  312.     CallModula(cd)
  313. END GetErrorFrame;
  314. PROCEDURE SystemHere*;
  315.     Tells loader, that system has come up to the point, that
  316.     it can display itself any error messages.
  317.     cd:CallData;
  318. BEGIN
  319.     cd[0]:=18;
  320.     CallModula(cd)
  321. END SystemHere;
  322. PROCEDURE Turbo*;
  323.     Set task priority high. Used before starting a command.
  324. VAR task: E.TaskPtr; dummy: LONGINT;
  325. BEGIN
  326.     dummy := E.SetTaskPri(task, normalPri)
  327. END Turbo;
  328. PROCEDURE Idle*;
  329.     Set task priority low. Used after a command finishes and Oberon.Loop resumes.
  330. VAR task: E.TaskPtr; dummy: LONGINT;
  331. BEGIN
  332.     dummy := E.SetTaskPri(task, idlePri)
  333. END Idle;
  334. PROCEDURE Close*;
  335.     Restore the original window in the process structure.
  336.     Close Oberon window and screen.
  337.     Free Chip-Mem-Pool.
  338.     Treminate all Amiga* Modules.
  339.     proc:ProcessPtr;
  340.     scr:ScreenPtr;
  341.     win:WindowPtr;
  342.     i: INTEGER;
  343. BEGIN
  344.     IF oldProcessWindow#0 THEN
  345.         proc:=SYSTEM.VAL(ProcessPtr,E.FindTask(0));
  346.         proc.windowPtr:=oldProcessWindow;
  347.     END;
  348.     win := SYSTEM.VAL(WindowPtr, window); scr := SYSTEM.VAL(ScreenPtr, screen);
  349.     IF PensObtained THEN
  350.         FOR i:=0 TO SHORT(ASH(1, OberonDepth))-1 DO
  351.             G.ReleasePen(scr.viewPort.colorMap, i+ColorOffset)
  352.         END;
  353.     END;
  354.     IF win#NIL THEN I.CloseWindow(window); win := NIL END;
  355.     IF scr#NIL THEN I.CloseScreen(screen); scr := NIL END;
  356.     window := SYSTEM.VAL(LONGINT, win); screen := SYSTEM.VAL(LONGINT, scr);
  357.     IF ChipMemPool#0 THEN E.DeletePool(ChipMemPool) END;
  358.     E.TermAll
  359. END Close;
  360. PROCEDURE GetDefaultMode(VAR info:Info; VAR fromEnv:BOOLEAN);
  361.     Initialise info with the values from the environment. If this is not
  362.     possible, use the default sizes, and the screen mode of the workbench
  363.     screen (if available). fromEnv returns FALSE, if the environment wasn't
  364.     found.
  365.     key:LONGINT;
  366.     len:LONGINT;
  367.     scr:ScreenPtr;
  368.     DosV36: BOOLEAN;
  369. BEGIN
  370.     DosV36:=D.dosVersion<=37; (* docu said 36, but testing said 37 *)
  371.     len:=D.GetVar(envName,SYSTEM.ADR(info),SIZE(Info),{D.globalOnly,D.binaryVar,D.dontNullTerm});
  372.     fromEnv:=((DosV36 & (len=SIZE(Info)-1)) OR ((~DosV36) & (len=SIZE(Info)))) & (info.version=infoVersion);
  373.     IF ~fromEnv THEN
  374.         scr:=SYSTEM.VAL(ScreenPtr,I.LockPubScreen(0));
  375.         IF scr#NIL THEN
  376.             key:=G.GetVPModeID(SYSTEM.ADR(scr.viewPort));
  377.             I.UnlockPubScreen(0,SYSTEM.VAL(I.ScreenPtr,scr))
  378.         ELSE
  379.             key:=G.hiresLaceKey
  380.         END;
  381.         info.version:=infoVersion;
  382.         info.displayID:=key;
  383.         info.width:=defaultWidth;
  384.         info.height:=defaultHeight;
  385.         info.depth:=defaultDepth;
  386.         info.oscan:=I.oScanText;
  387.         info.autoScroll:=TRUE;
  388.         info.useWBWindow:=FALSE;
  389.         info.modifyColors:=FALSE;
  390. END GetDefaultMode;
  391. PROCEDURE ReadScreenMode*(VAR displayID:LONGINT;
  392.         VAR height, width, depth: INTEGER; VAR oscan:LONGINT; VAR autoScroll, WBWindow, PrivateColors: BOOLEAN);
  393.     Read the environment variable, and extract from it all values
  394.     needed for screen initialization. Use the default values, if the
  395.     environment variable doesn't exist, or has a wrong version.
  396.     dummy:BOOLEAN;
  397.     info:Info;
  398. BEGIN
  399.     GetDefaultMode(info,dummy);
  400.     displayID:=info.displayID;
  401.     width:=info.width;
  402.     height:=info.height;
  403.     depth:=info.depth;
  404.     oscan:=info.oscan;
  405.     autoScroll:=info.autoScroll;
  406.     WBWindow:=info.useWBWindow;
  407.     PrivateColors:=info.modifyColors;
  408. END ReadScreenMode;
  409. PROCEDURE WriteScreenMode*(displayID:LONGINT;
  410.         height, width, depth: INTEGER; oscan:LONGINT; autoScroll, useWBWindow, modifyColors:BOOLEAN);
  411.     Store the screen values into the environment variable. On pre 3.0 Amigas
  412.     write them also to the envarc: files as SetVar won't do it for you.
  413.     dummy:LONGINT;
  414.     dummyB:BOOLEAN;
  415.     f:D.FileHandlePtr;
  416.     info:Info;
  417. BEGIN
  418.     info.version:=infoVersion;
  419.     info.displayID:=displayID;
  420.     info.width:=width;
  421.     info.height:=height;
  422.     info.depth:=depth;
  423.     info.oscan:=oscan;
  424.     info.autoScroll:=autoScroll;
  425.     info.useWBWindow:=useWBWindow;
  426.     info.modifyColors:=modifyColors;
  427.     dummyB:=D.SetVar(
  428.         envName,SYSTEM.ADR(info),SIZE(Info),{D.globalOnly,D.saveVar,D.binaryVar,D.dontNullTerm}
  429.     IF A.aslVersion<39 THEN
  430.         f:=D.Open(envarcName,D.readWrite);
  431.         IF f#0 THEN
  432.             dummy:=D.Write(f,info,SIZE(Info));
  433.             dummyB:=D.Close(f)
  434.         END
  435. END WriteScreenMode;
  436. PROCEDURE ChangeMode2(info:Info);
  437.     Present a screen mode requester prefilled with the values from info.
  438.     Store the returned values into the environment.
  439.     ScreenModeRequesterPtr=POINTER TO A.ScreenModeRequester;
  440.     ok, useWBWindow, modifyColors: BOOLEAN;
  441.     screenRequest:ScreenModeRequesterPtr;
  442.     tags:ARRAY 15 OF U.TagItem;
  443. BEGIN
  444.     I.ClearPointer(window);
  445.     tags[0].tag:=A.tsmDoAutoScroll;
  446.     tags[0].data:=SYSTEM.VAL(LONGINT,TRUE);
  447.     tags[1].tag:=A.tsmDoDepth;
  448.     tags[1].data:=SYSTEM.VAL(LONGINT,TRUE);
  449.     tags[2].tag:=A.tsmDoHeight;
  450.     tags[2].data:=SYSTEM.VAL(LONGINT,TRUE);
  451.     tags[3].tag:=A.tsmDoOverscanType;
  452.     tags[3].data:=SYSTEM.VAL(LONGINT,TRUE);
  453.     tags[4].tag:=A.tsmDoWidth;
  454.     tags[4].data:=SYSTEM.VAL(LONGINT,TRUE);
  455.     tags[5].tag:=A.tsmInitialAutoScroll;
  456.     IF info.autoScroll THEN
  457.         tags[5].data:=-1
  458.     ELSE
  459.         tags[5].data:=0
  460.     END;
  461.     tags[6].tag:=A.tsmInitialDisplayDepth;
  462.     tags[6].data:=info.depth;
  463.     tags[7].tag:=A.tsmInitialDisplayHeight;
  464.     tags[7].data:=info.height;
  465.     tags[8].tag:=A.tsmInitialDisplayID;
  466.     tags[8].data:=info.displayID;
  467.     tags[9].tag:=A.tsmInitialDisplayWidth;
  468.     tags[9].data:=info.width;
  469.     tags[10].tag:=A.tsmInitialOverscanType;
  470.     tags[10].data:=info.oscan;
  471.     tags[11].tag:=A.tsmScreen;
  472.     tags[11].data:=screen;
  473.     tags[12].tag:=A.tsmMaxDepth;
  474.     tags[12].data:=maxDepth;
  475.     tags[13].tag:=U.done;
  476.     screenRequest:=SYSTEM.VAL(ScreenModeRequesterPtr,A.AllocAslRequest(A.aslScreenModeRequest,tags));
  477.     Assert(screenRequest#NIL,"No ScreenModeRequester");
  478.     tags[0].tag:=U.done;
  479.     ok:=A.AslRequest(SYSTEM.VAL(LONGINT,screenRequest),tags);
  480.     IF ok THEN
  481.         useWBWindow:=
  482.             I.CallEasyRequest(window, {}, "Oberon System V4 for Amiga", "Use Custom Screen ?","Yes|No")=0;
  483.         modifyColors:=FALSE;
  484.         IF useWBWindow THEN
  485.             modifyColors:=I.CallEasyRequest(window, {}, "Oberon System V4 for Amiga",
  486.                 "Modify Default Colors If Necessary ?", "Yes|No")#0;
  487.         END;
  488.         WriteScreenMode(
  489.             screenRequest.displayID,SHORT(screenRequest.displayHeight),SHORT(screenRequest.displayWidth)
  490.             ,screenRequest.displayDepth,screenRequest.overscanType,screenRequest.autoScroll#0
  491.             ,useWBWindow, modifyColors
  492.     END;
  493.     A.FreeAslRequest(SYSTEM.VAL(LONGINT,screenRequest));
  494.     screenRequest:=NIL;
  495.     I.SetPointer(window,pointerData,0,0,0,0)
  496. END ChangeMode2;
  497. PROCEDURE ChangeMode*(VAR res:INTEGER);
  498.     Present screen mode requester if the OS version
  499.     supports it. Used by System.ChangeMode.
  500.     dummy:BOOLEAN;
  501.     info:Info;
  502. BEGIN
  503.     IF A.aslVersion>=38 THEN
  504.         GetDefaultMode(info,dummy);
  505.         ChangeMode2(info);
  506.         res:=0
  507.     ELSE
  508.         res:=1
  509. END ChangeMode;
  510. PROCEDURE DosCmd*(cmd, outName:ARRAY OF CHAR; VAR res:INTEGER);
  511.     Run a program with STDIN set to NIL: and STDOUT set to output.
  512.     in,out:D.FileHandlePtr;
  513.     tags:ARRAY 4 OF U.TagItem;
  514. BEGIN
  515.     in:=D.Open("NIL:",D.oldFile);
  516.     ASSERT(in#0);
  517.     out:=D.Open(outName,D.newFile);
  518.     ASSERT(out#0);
  519.     tags[0].tag:=D.sysInput;
  520.     tags[0].data:=in;
  521.     tags[1].tag:=D.sysOutput;
  522.     tags[1].data:=out;
  523.     tags[2].tag:=D.npCloseOutput;
  524.     tags[2].data:=SYSTEM.VAL(LONGINT,FALSE);
  525.     tags[3].tag:=U.done;
  526.     res:=SHORT(D.System(cmd,tags));
  527.     IF D.Close(out) THEN END;
  528.     IF D.Close(in) THEN END
  529. END DosCmd;
  530. PROCEDURE Loop*;
  531.     This is the loop, which the loader calls instead of Oberon.Loop.
  532.     It remembers the current stack pointer before calling Oberon.Loop,
  533.     so the trap handler can return us into the loop, and we can restart
  534.     Oberon.Loop after each trap.
  535.     imported:ARRAY 32 OF CHAR;
  536.     mod,modules:Module;
  537.     oberonLoop:PROCEDURE;
  538.     res:INTEGER;
  539. BEGIN
  540.     ThisMod("Oberon",mod,res,modules,imported);
  541.     Assert(res=0,"Amiga.Loop: Oberon not found");
  542.     ThisCommand(mod,"Loop",SYSTEM.VAL(Absolute,oberonLoop),res);
  543.     Assert(res=0,"Amiga.Loop: Oberon.Loop not found");
  544.     LOOP
  545.         SaveRegs;
  546.         SYSTEM.GETREG(15,stackPtr);
  547.         DEC(stackPtr,4); (* stack pointer value after call of oberonLoop. *)
  548.         oberonLoop;
  549.         LoadRegs
  550. END Loop;
  551. PROCEDURE InitSwapBits;
  552.     Init swaps array to swap the bits within a byte [76543210] -> [01234567]
  553. VAR  i,j, in,res:INTEGER;
  554. BEGIN
  555.     FOR j:=0 TO 255 DO
  556.         res:=0;  in:=j;
  557.         FOR i:=0 TO 7 DO
  558.             res:=res*2+in MOD 2;  in:=in DIV 2
  559.         END;
  560.         SwapBits[j] := CHR(res);
  561.     END;
  562. END InitSwapBits;
  563. PROCEDURE Init;
  564.     Get the screen infos and initialize the Oberon screen and window.
  565.     Install a blank sprite as pointer. Install the termination procedure for
  566.     all this.
  567.     Initialise the gloabl variables for character conversion and middle
  568.     mouse button replacement.
  569.     fromEnv:BOOLEAN;
  570.     info:Info;
  571.     proc:ProcessPtr;
  572.     scr:ScreenPtr;
  573.     scrrp:RPPtr;
  574.     tags:ARRAY 13 OF U.TagItem;
  575.     win:WindowPtr;
  576.     bm: BitmapPtr;
  577.     i: INTEGER;
  578.     PROCEDURE OpenScreen();
  579.     BEGIN
  580.         Depth:=info.depth; OberonDepth:=Depth;
  581.         Height:=info.height;
  582.         Width:=(info.width DIV 8)*8;
  583.         tags[0].tag:=I.saDepth;
  584.         tags[0].data:=info.depth;
  585.         tags[1].tag:=I.saHeight;
  586.         tags[1].data:=Height;
  587.         tags[2].tag:=I.saWidth;
  588.         tags[2].data:=Width;
  589.         tags[3].tag:=I.saDisplayID;
  590.         tags[3].data:=info.displayID;
  591.         tags[4].tag:=I.saQuiet;
  592.         tags[4].data:=-1;
  593.         tags[5].tag:=I.saAutoScroll;
  594.         tags[5].data:=-1;
  595.         tags[6].tag:=I.saOverscan;
  596.         tags[6].data:=info.oscan;
  597.         tags[7].tag:=I.saBehind;
  598.         tags[7].data:=-1;
  599.         tags[8].tag:=I.saDetailPen;
  600.         tags[8].data:=0;
  601.         tags[9].tag:=I.saBlockPen;
  602.         tags[9].data:=SYSTEM.LSH(1,Depth)-1;
  603.         tags[10].tag:=I.saTitle;
  604.         tags[10].data:=SYSTEM.ADR(screenTitle);
  605.         tags[11].tag:=I.saInterleaved;
  606.         tags[11].data:=-1;
  607.         tags[11].tag:=U.done;
  608.         screen:=I.OpenScreenTags(0(*NIL*),tags); scr := SYSTEM.VAL(ScreenPtr, screen);
  609.         Assert(scr#NIL,"No screen");
  610.         tags[0].tag:=I.waCustomScreen;
  611.         tags[0].data:= screen;
  612.         tags[1].tag:=I.waIDCMP;
  613.         tags[1].data:=SYSTEM.VAL(LONGINT, {I.rawKey,I.mouseButtons(*,I.mouseMove*)});
  614.         tags[1].data:=SYSTEM.VAL(LONGINT, {}); (* For new Input *)        (*<<RD*)
  615.         tags[2].tag:=I.waFlags;
  616.         tags[2].data:=SYSTEM.VAL(LONGINT, {I.backDrop,I.borderless,I.activate,I.rmbTrap,I.noCareRefresh});
  617.         tags[3].tag:=U.done;
  618.         window:=I.OpenWindowTags(0(*NIL*),tags); win := SYSTEM.VAL(WindowPtr, window);
  619.         Assert(win#NIL,"No window");
  620.         I.ShowTitle(screen,FALSE);
  621.         I.ScreenToFront(screen);
  622.         ModifyColors:=TRUE
  623.     END OpenScreen;
  624.     PROCEDURE OpenWBWindow();
  625.         VAR image: ARRAY 16 OF SET; i, OberonCols, AmigaCols: INTEGER;
  626.         PROCEDURE FindColors(): BOOLEAN;
  627.             VAR i, j: INTEGER;
  628.         BEGIN
  629.             i:=0;
  630.             WHILE i<AmigaCols DO
  631.                 j:=0;
  632.                 WHILE G.ObtainPen(scr.viewPort.colorMap, i+j, 0, 0, 0, {G.penbExclusive, G.penbNoSetcolor})#-1 DO
  633.                     INC(j);
  634.                     IF j=OberonCols THEN
  635.                         ColorOffset:=i;
  636.                         PensObtained:=TRUE;
  637.                         ModifyColors:=TRUE;
  638.                         RETURN TRUE;
  639.                     END;
  640.                 END;
  641.                 WHILE j#0 DO
  642.                     DEC(j);
  643.                     G.ReleasePen(scr.viewPort.colorMap, i+j);
  644.                 END;
  645.                 INC(i, OberonCols)
  646.             END;
  647.             RETURN FALSE
  648.         END FindColors;
  649.     BEGIN
  650.         screen:=I.LockPubScreen(0);
  651.         scr:=SYSTEM.VAL(ScreenPtr, screen);
  652.         Assert(scr#NIL,"No screen");
  653.         scrrp:=SYSTEM.VAL(RPPtr, SYSTEM.ADR(scr.rastPort));
  654.         bm:=SYSTEM.VAL(BitmapPtr, scrrp.bitMap);
  655.         AmigaCols:=SHORT(ASH(1, bm.depth));
  656.         OberonCols:=SHORT(ASH(1, info.depth));
  657.         IF (E.execVersion<39) OR (~FindColors()) THEN
  658.             IF ModifyColors & (OberonCols<AmigaCols) THEN
  659.                 ColorOffset:=AmigaCols DIV 2;
  660.             END;
  661.         END;
  662.         tags[0].tag:=I.waIDCMP;
  663.         tags[0].data:=SYSTEM.VAL(LONGINT, {I.closeWindow, I.rawKey,I.mouseButtons(*,I.mouseMove*)});
  664.         tags[0].data:=SYSTEM.VAL(LONGINT, {});  (* For new Input *)        (*<<RD*)
  665.         tags[1].tag:=I.waFlags;
  666.         tags[1].data:=SYSTEM.VAL(LONGINT,
  667.                  {I.windowClose, I.windowDrag, I.windowDepth,I.rmbTrap,I.noCareRefresh, I.gimmeZeroZero});
  668.         tags[2].tag:=I.waInnerWidth;
  669.         tags[2].data:=(info.width DIV 8)* 8;
  670.         tags[3].tag:=I.waInnerHeight;
  671.         tags[3].data:=info.height;
  672.         tags[4].tag:=I.waTitle;
  673.         tags[4].data:=SYSTEM.ADR(screenTitle);
  674.         tags[5].tag:=I.waScreenTitle;
  675.         tags[5].data:=SYSTEM.ADR(screenTitle);
  676.         tags[6].tag:=I.waAutoAdjust;
  677.         tags[6].data:=1;
  678.         tags[7].tag:=I.waPubScreen;
  679.         tags[7].data:=screen;
  680.         tags[8].tag:=U.done;
  681.         window:=I.OpenWindowTags(0(*NIL*),tags); win := SYSTEM.VAL(WindowPtr, window);
  682.         Assert(win#NIL,"No window");
  683.         I.UnlockPubScreen(0, screen);
  684.         Height:=win.gzzHeight;
  685.         Width:=(win.gzzWidth DIV 8)*8
  686.     END OpenWBWindow;
  687. BEGIN
  688.     ColorOffset:=0; PensObtained:=FALSE;
  689.     IF E.execVersion>=39 THEN
  690.         ChipMemPool:=E.CreatePool({E.memChip}, PoolPuddleSize, PoolThreshSize);
  691.         Assert(ChipMemPool#0, "Can not create memory pool for fonts")
  692.     ELSE
  693.         ChipMemPool:=0
  694.     END;
  695.     IF ChipMemPool#0 THEN
  696.         pointerData:=E.AllocPooled(ChipMemPool, pointerSize);
  697.     ELSE
  698.         pointerData:=E.AllocMem(pointerSize,{E.memChip,E.memClear})
  699.     END;
  700.     InitSwapBits;
  701.     version:=screenTitle;
  702.     IF A.aslVersion>=38 THEN
  703.         GetDefaultMode(info,fromEnv);
  704.         IF ~fromEnv THEN
  705.             ChangeMode2(info);
  706.             GetDefaultMode(info,fromEnv)
  707.         END
  708.     ELSE
  709.         GetDefaultMode(info,fromEnv)
  710.     END;
  711.     WBWindow:=info.useWBWindow; ModifyColors:=info.modifyColors;
  712.     IF WBWindow THEN OpenWBWindow() ELSE OpenScreen() END;
  713.     thisTask:=E.FindTask(0);
  714.     proc:=SYSTEM.VAL(ProcessPtr,thisTask);
  715.     oldProcessWindow:=proc.windowPtr;
  716.     proc.windowPtr:=window;
  717.     I.SetPointer(window,pointerData,0,0,0,0);
  718.     I.ActivateWindow(window);
  719.     scrrp:=SYSTEM.VAL(RPPtr, SYSTEM.ADR(scr.rastPort));
  720.     bm:=SYSTEM.VAL(BitmapPtr, scrrp.bitMap);
  721.     Depth:=bm.depth;
  722.     IF info.depth<=Depth THEN OberonDepth:=info.depth ELSE OberonDepth:=Depth END;
  723.     TermProcedure(Close);
  724.     useLAltAsMouse:=TRUE;
  725.     idlePri:=-128;
  726.     normalPri:=0;
  727.     TicsToWait:=20000;
  728.     PrinterName:="PrinterOut.ps";
  729.     PictPrintThresh:=128;
  730.     UseQuitRequester:=FALSE;
  731. END Init;
  732. BEGIN
  733.     stackPtr:=0;
  734.         Ensure, that OLoad probably guessed right, when patching in loaderCall.
  735.     Assert((guard1=002468ACEH) & (guard2=013579BDFH),"Amiga: wrong loader call guards.");
  736.     Init
  737. END Amiga.
  738.